home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
c
/
unixfasl.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
8KB
|
370 lines
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
#include "include.h"
#ifdef BSD
#include <a.out.h>
#endif
#ifdef ATT
#include <filehdr.h>
#include <scnhdr.h>
#include <syms.h>
#endif
#ifdef E15
#include <a.out.h>
#define exec bhdr
#define a_text tsize
#define a_data dsize
#define a_bss bsize
#define a_syms ssize
#define a_trsize rtsize
#define a_drsize rdsize
#endif
#define MAXPATHLEN 1024
int
fasload(faslfile)
object faslfile;
{
#ifdef BSD
struct exec header, newheader;
#define textsize header.a_text
#define datasize header.a_data
#define bsssize header.a_bss
#define textstart sizeof(header)
#define newbsssize newheader.a_bss
#endif
#ifdef ATT
struct filehdr fileheader;
struct scnhdr sectionheader;
int textsize, datasize, bsssize;
int textstart;
#endif
#ifdef E15
struct exec header;
#define textsize header.a_text
#define datasize header.a_data
#define bsssize header.a_bss
#define textstart sizeof(header)
#endif
object memory, data, tempfile;
FILE *fp;
char filename[MAXPATHLEN];
char tempfilename[32];
char command[MAXPATHLEN * 2];
int i;
object *old_vs_base = vs_base;
object *old_vs_top = vs_top;
#ifdef IBMRT
#endif
coerce_to_filename(faslfile, filename);
faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
vs_push(faslfile);
fp = faslfile->sm.sm_fp;
#ifdef BSD
fread(&header, sizeof(header), 1, fp);
#endif
#ifdef ATT
fread(&fileheader, sizeof(fileheader), 1, fp);
#ifdef S3000
if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1);
#endif
fread(§ionheader, sizeof(sectionheader), 1, fp);
textsize = sectionheader.s_size;
textstart = sectionheader.s_scnptr;
fread(§ionheader, sizeof(sectionheader), 1, fp);
datasize = sectionheader.s_size;
fread(§ionheader, sizeof(sectionheader), 1, fp);
if (strcmp(sectionheader.s_name, ".bss") == 0)
bsssize = sectionheader.s_size;
else
bsssize = 0;
#endif
#ifdef E15
fread(&header, sizeof(header), 1, fp);
#endif
memory = alloc_object(t_cfun);
memory->cf.cf_name = memory->cf.cf_data = OBJNULL;
memory->cf.cf_start = NULL;
memory->cf.cf_size = textsize + datasize + bsssize;
vs_push(memory);
memory->cf.cf_start = alloc_contblock(memory->cf.cf_size);
#ifdef BSD
fseek(fp,
header.a_text+header.a_data+
header.a_syms+header.a_trsize+header.a_drsize,
1);
fread(&i, sizeof(i), 1, fp);
fseek(fp, i - sizeof(i), 1);
#endif
#ifdef ATT
fseek(fp,
fileheader.f_symptr + SYMESZ*fileheader.f_nsyms,
0);
fread(&i, sizeof(i), 1, fp);
fseek(fp, i - sizeof(i), 1);
while ((i = getc(fp)) == 0)
;
ungetc(i, fp);
#endif
#ifdef E15
fseek(fp,
header.a_text+header.a_data+
header.a_syms+header.a_trsize+header.a_drsize,
1);
#endif
data = read_fasl_vector(faslfile);
vs_push(data);
close_stream(faslfile, TRUE);
sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
AGAIN:
#ifdef BSD
sprintf(command,
"ld -d -N -x -A %s -T %x %s -o %s",
kcl_self,
memory->cf.cf_start,
filename,
tempfilename);
#endif
#ifdef ATT
coerce_to_filename(symbol_value(siVsystem_directory),
system_directory);
sprintf(command,
"%sild %s %d %s %s",
system_directory,
kcl_self,
memory->cf.cf_start,
filename,
tempfilename);
#endif
#ifdef E15
coerce_to_filename(symbol_value(siVsystem_directory),
system_directory);
sprintf(command,
"%sild %s %d %s %s",
system_directory,
kcl_self,
memory->cf.cf_start,
filename,
tempfilename);
#endif
if (system(command) != 0)
FEerror("The linkage editor failed.", 0);
tempfile = make_simple_string(tempfilename);
vs_push(tempfile);
tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
vs_push(tempfile);
fp = tempfile->sm.sm_fp;
#ifdef BSD
fread(&newheader, sizeof(header), 1, fp);
if (newbsssize != bsssize) {
insert_contblock(memory->cf.cf_start, memory->cf.cf_size);
bsssize = newbsssize;
memory->cf.cf_start = NULL;
memory->cf.cf_size = textsize + datasize + bsssize;
memory->cf.cf_start = alloc_contblock(memory->cf.cf_size);
close_stream(tempfile, TRUE);
unlink(tempfilename);
goto AGAIN;
}
#endif
if (fseek(fp, textstart, 0) < 0)
error("file seek error");
fread(memory->cf.cf_start, textsize + datasize, 1, fp);
close_stream(tempfile, TRUE);
#ifdef IBMRT
#endif
unlink(tempfilename);
#ifdef IBMRT
#else
(*(int (*)())(memory->cf.cf_start))
#endif
(memory->cf.cf_start, memory->cf.cf_size, data);
vs_base = old_vs_base;
vs_top = old_vs_top;
return(memory->cf.cf_size);
}
#ifdef BSD
int
faslink(faslfile, ldargstring)
object faslfile, ldargstring;
{
struct exec header, faslheader;
#define textsize header.a_text
#define datasize header.a_data
#define bsssize header.a_bss
#define textstart sizeof(header)
object memory, data, tempfile;
FILE *fp;
char filename[MAXPATHLEN];
char ldargstr[MAXPATHLEN];
char tempfilename[32];
char command[MAXPATHLEN * 2];
char buf[BUFSIZ];
int i;
object *old_vs_base = vs_base;
object *old_vs_top = vs_top;
#ifdef IBMRT
#endif
coerce_to_filename(ldargstring, ldargstr);
coerce_to_filename(faslfile, filename);
sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
sprintf(command,
"ld -d -N -x -A %s -T %x %s %s -o %s",
kcl_self,
(int)core_end,
filename,
ldargstr,
tempfilename);
if (system(command) != 0)
FEerror("The linkage editor failed.", 0);
fp = fopen(tempfilename, "r");
setbuf(fp, buf);
fread(&header, sizeof(header), 1, fp);
memory = alloc_object(t_cfun);
memory->cf.cf_name = memory->cf.cf_data = OBJNULL;
memory->cf.cf_start = NULL;
memory->cf.cf_size = textsize + datasize + bsssize;
vs_push(memory);
memory->cf.cf_start = alloc_contblock(memory->cf.cf_size);
fclose(fp);
faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
vs_push(faslfile);
fp = faslfile->sm.sm_fp;
fread(&faslheader, sizeof(faslheader), 1, fp);
fseek(fp,
faslheader.a_text+faslheader.a_data+
faslheader.a_syms+faslheader.a_trsize+faslheader.a_drsize,
1);
fread(&i, sizeof(i), 1, fp);
fseek(fp, i - sizeof(i), 1);
data = read_fasl_vector(faslfile);
vs_push(data);
close_stream(faslfile, TRUE);
sprintf(command,
"ld -d -N -x -A %s -T %x %s %s -o %s",
kcl_self,
memory->cf.cf_start,
filename,
ldargstr,
tempfilename);
if (system(command) != 0)
FEerror("The linkage editor failed.", 0);
tempfile = make_simple_string(tempfilename);
vs_push(tempfile);
tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
vs_push(tempfile);
fp = tempfile->sm.sm_fp;
if (fseek(fp, textstart, 0) < 0)
error("file seek error");
fread(memory->cf.cf_start, textsize + datasize, 1, fp);
close_stream(tempfile, TRUE);
#ifdef IBMRT
#endif
unlink(tempfilename);
#ifdef IBMRT
#else
(*(int (*)())(memory->cf.cf_start))
(memory->cf.cf_start, memory->cf.cf_size, data);
#endif
vs_base = old_vs_base;
vs_top = old_vs_top;
return(memory->cf.cf_size);
}
siLfaslink()
{
bds_ptr old_bds_top;
int i;
object package;
check_arg(2);
check_type_or_pathname_string_symbol_stream(&vs_base[0]);
check_type_string(&vs_base[1]);
vs_base[0] = coerce_to_pathname(vs_base[0]);
vs_base[0]->pn.pn_type = FASL_string;
vs_base[0] = namestring(vs_base[0]);
package = symbol_value(Vpackage);
old_bds_top = bds_top;
bds_bind(Vpackage, package);
i = faslink(vs_base[0], vs_base[1]);
bds_unwind(old_bds_top);
vs_top = vs_base;
vs_push(make_fixnum(i));
}
#endif
init_unixfasl()
{
#ifdef BSD
make_si_function("FASLINK", siLfaslink);
#endif
}